home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / vgacodng / part07_c.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-12-15  |  2.4 KB  |  81 lines
  1. program ShadeBob2;
  2.  
  3. uses crt;
  4.  
  5. var Pal : array[0..767] of byte;
  6.     x1,y1,x2,y2 : word;            { X- und Y-Koords der beiden Bobs }
  7.     incx1,incy1,incx2,incy2 : shortint; { Inkrementationsparameter }
  8.  
  9. procedure SetPalette;assembler;    { Setzt die Palette in Pal }
  10. asm
  11.   mov     dx,3C8h
  12.   xor     al,al
  13.   out     dx,al
  14.   mov     cx,768
  15.   mov     dx,3C9h
  16.   mov     si,offset pal
  17. @Jmp1:
  18.   lodsb
  19.   out     dx,al
  20.   loop    @Jmp1
  21. end;
  22.  
  23. procedure RainbowPal; { Erstellt eine bunte Palette }
  24. var loop : integer;
  25.  
  26. begin
  27.   for loop := 0 to 31 do begin
  28.     pal[loop*3] := loop * 2;
  29.     pal[(63-loop)*3] := loop * 2;
  30.     pal[(loop+64)*3+1] := loop * 2;
  31.     pal[(127-loop)*3+1] := loop * 2;
  32.     pal[(loop+128)*3+2] := loop * 2;
  33.     pal[(191-loop)*3+2] := loop * 2;
  34.     pal[(loop+192)*3] := loop * 2;
  35.     pal[(loop+192)*3+1] := loop * 2;
  36.     pal[(loop+192)*3+2] := loop * 2;
  37.     pal[(255-loop)*3] := loop * 2;
  38.     pal[(255-loop)*3+1] := loop * 2;
  39.     pal[(255-loop)*3+2] := loop * 2;
  40.   end;
  41.   setpalette;
  42. end;
  43.  
  44. procedure SetBob(x,y:word);  { Setzt ein Bob an die Koords X,Y }
  45. var n1,n2 : byte;
  46.  
  47. begin
  48.   for n1 := 0 to 19 do    { Hier werden in einem 20x20 Pixel großen Quadrat }
  49.     for n2 := 0 to 19 do  { alle Pixelwerte um 1 erhöht }
  50.       mem[$A000:(n2+y)*320+n1+x] := mem[$A000:(n2+y)*320+n1+x] + 1;
  51. end;
  52.  
  53.  
  54. begin
  55.   asm mov ax,13h; int 10h end;
  56.   RainbowPal;
  57.   randomize;
  58.   x1 := random(280);               { Zufällige X- und Y- Positionen für }
  59.   y1 := random(160);               { beide Bobs }
  60.   x2 := random(280);
  61.   y2 := random(160);
  62.   incx1 := 1;                      { Bob 1 wird nach rechts und nach unten }
  63.   incy1 := 1;                      { bewegt }
  64.   incx2 := -1;                     { Bob 2 wird nach links und nach unten }
  65.   incy2 := 1;                      { bewegt }
  66.   repeat
  67.     inc(x1,incx1);                 { Bob-Positionen verändern }
  68.     inc(y1,incy1);
  69.     inc(x2,incx2);
  70.     inc(y2,incy2);
  71.     if (x1 = 299) or (x1 = 0) then incx1 := -incx1; { Überprüfen, ob einer }
  72.     if (y1 = 179) or (y1 = 0) then incy1 := -incy1; { der Bobs am Rand des }
  73.     if (x2 = 299) or (x2 = 0) then incx2 := -incx2; { Screens ist, und wenn }
  74.     if (y2 = 179) or (y2 = 0) then incy2 := -incy2; { ja dann Wert umkehren }
  75.     SetBob(x1,y1);                 { Die beiden Bobs zeichnen }
  76.     SetBob(x2,y2);
  77.   until keypressed;
  78.   readkey;
  79.   asm mov ax,3; int 10h end;
  80. end.
  81.